home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / pgplot5.1 / pgplot5 / pgplot5.1.0 / examples-src / pgdemo2.f < prev    next >
Encoding:
Text File  |  1996-04-08  |  14.2 KB  |  498 lines
  1.       PROGRAM PGDEM2
  2. C-----------------------------------------------------------------------
  3. C Demonstration program for PGPLOT. The main program opens the output
  4. C device and calls a series of subroutines, one for each sample plot.
  5. C-----------------------------------------------------------------------
  6.       INTEGER PGOPEN
  7. C
  8. C Call PGOPEN to initiate PGPLOT and open the output device; PGOPEN
  9. C will prompt the user to supply the device name and type.
  10. C
  11.       IF (PGOPEN('?') .LE. 0) STOP
  12. C
  13. C Call the demonstration subroutines.
  14. C
  15.       CALL PGEX21
  16.       CALL PGEX22
  17.       CALL PGEX23
  18.       CALL PGEX24
  19.       CALL PGEX25
  20.       CALL PGEX26
  21. C
  22. C Finally, call PGCLOS to terminate things properly.
  23. C
  24.       CALL PGCLOS
  25. C-----------------------------------------------------------------------
  26.       END
  27.  
  28.       SUBROUTINE PGEX21
  29. C-----------------------------------------------------------------------
  30. C Test subroutine for PGPLOT: screen alignment and color palette.
  31. C-----------------------------------------------------------------------
  32.       INTEGER I, L1, L2
  33.       REAL X1, X2, Y1, Y2
  34.       CHARACTER*80 GTYPE, GVER
  35. C
  36. C Get PGPLOT information.
  37. C
  38.       CALL PGQINF('VERSION', GVER, L1)
  39.       CALL PGQINF('TYPE', GTYPE, L2)
  40.       CALL PGBBUF
  41. C
  42. C Alignment test: clear the screen, and draw a box and grid using
  43. C three monochrome intensities (color indices 1, 14, and 15).  The
  44. C plot uses the largest available square viewport and and unit window.
  45. C
  46.       CALL PGPAGE
  47.       CALL PGSVP(0.0,1.0,0.0,1.0)
  48.       CALL PGWNAD(0.0,1.0,0.0,1.0)
  49.       CALL PGSCI(14)
  50.       CALL PGBOX('g',0.02,1,'g',0.02,1)
  51.       CALL PGSCI(15)
  52.       CALL PGBOX('g',0.1,5,'g',0.1,5)
  53.       CALL PGSCI(1)
  54.       CALL PGBOX('bc',0.1,5,'bc',0.1,5)
  55. C
  56. C Color palette test.
  57. C
  58.       DO 20 I=0,15
  59.           CALL PGSCI(I)
  60.           X1 = 0.31 + MOD(I,4)*0.1
  61.           Y1 = 0.61 - (I/4)*0.1
  62.           X2 = X1 + 0.08
  63.           Y2 = Y1 + 0.08
  64.           CALL PGRECT(X1, X2, Y1, Y2)
  65.    20 CONTINUE
  66. C
  67. C Write the device type on the plot.
  68. C
  69.       CALL PGSCI(0)
  70.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  71.       CALL PGSCI(1)
  72.       CALL PGSFS(2)
  73.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  74.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  75.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  76. C
  77.       CALL PGEBUF
  78. C-----------------------------------------------------------------------
  79.       END
  80.  
  81.       SUBROUTINE PGEX22
  82. C-----------------------------------------------------------------------
  83. C Demonstration program for the PGPLOT plotting package.
  84. C Plot a table of the standard PGPLOT graph marker symbols. This
  85. C program also illustrates how windows and viewports may be manipulated.
  86. C-----------------------------------------------------------------------
  87.       CHARACTER*2 LABEL
  88.       INTEGER NX, NY, N, IX, JY, LW
  89.       REAL X, X1, X2, XOFF, Y, Y1, Y2, YOFF, DX, DY
  90.       REAL XPIX1, XPIX2, YPIX1, YPIX2, RES
  91. C
  92. C Determine size of view surface.
  93. C Lower left corner is (X1,Y1), upper right (X2, Y2) [inches].
  94. C
  95.       CALL PGPAGE
  96.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  97.       CALL PGQVP(1, X1, X2, Y1, Y2)
  98.       X = X2-X1
  99.       Y = Y2-Y1
  100. C
  101. C Determine device resolution (pixels/inch), and use it to choose
  102. C line width.
  103. C
  104.       CALL PGQVP(3, XPIX1, XPIX2, YPIX1, YPIX2)
  105.       RES = ABS(XPIX2-XPIX1)/ABS(X)
  106.       LW = 1
  107.       IF (RES.GT.166.0) LW = 2
  108. C
  109. C Choose horizontal or vertical arrangement depending on
  110. C device aspect ratio.
  111. C
  112.       IF (X.GT.Y) THEN
  113.           NX = 8
  114.           NY = 5
  115.       ELSE
  116.           NX = 5
  117.           NY = 8
  118.       END IF
  119.       DX = MIN(X/NX, 0.95*Y/NY)
  120.       DY = DX
  121.       IX = NX
  122.       JY = 1
  123.       XOFF = X1 + (X-NX*DX)*0.5
  124.       YOFF = Y1 + (0.95*Y-NY*DY)*0.5
  125.       CALL PGBBUF
  126. C
  127. C Each symbol will be drawn in a standard window; the window is moved
  128. C by manipulating the viewport.
  129. C
  130.       CALL PGSWIN(-1.,1.,-1.,1.)
  131. C
  132. C Loop through all known symbols (N=0-31 and -1 to -8). 
  133. C
  134.       DO 10 N=0,39
  135.           IF (N.LE.31) WRITE (LABEL,'(I2)') N
  136.           IF (N.GT.31) WRITE (LABEL,'(I2)') 31-N
  137. C
  138. C Define window and viewport. The loop allows the plot to extend over
  139. C more than one page if necessary; each page is labelled at the top.
  140. C
  141.           IX = IX+1
  142.           IF (IX.GT.NX) THEN
  143.             IX = 1
  144.             JY = JY-1
  145.           END IF
  146.           IF (JY.LT.1) THEN
  147.             JY = NY
  148.             IF (N.NE.0) CALL PGPAGE
  149.             CALL PGSCH(1.2)
  150.             CALL PGVSIZ(XOFF, XOFF+NX*DX, YOFF, YOFF+NY*DY)
  151.             CALL PGSLW(LW)
  152.             CALL PGMTXT('T', 1.0, 0.5, 0.5,
  153.      1                   '\fiPGPLOT \frMarker Symbols')
  154.           END IF
  155.           CALL PGVSIZ(XOFF+(IX-1)*DX, XOFF+IX*DX,
  156.      1                 YOFF+(JY-1)*DY, YOFF+JY*DY)
  157. C
  158. C Call PGBOX to draw a box and PGMTXT to label it.
  159. C
  160.           CALL PGSLW(1)
  161.           CALL PGBOX('BC',10.0,0,'BC',10.0,0)
  162.           CALL PGSCH(0.5)
  163.           CALL PGMTXT('T',-1.5,0.05,0.0,LABEL)
  164. C
  165. C Call PGPT to draw the symbol.
  166. C
  167.           CALL PGSLW(LW)
  168.           CALL PGSCH(1.5)
  169.           IF (N.LE.31) CALL PGPT(1,0.0,0.0,N)
  170.           IF (N.GT.31) CALL PGPT(1,0.0,0.0,31-N)
  171.    10 CONTINUE
  172. C
  173.       CALL PGEBUF
  174. C-----------------------------------------------------------------------
  175.       END
  176.  
  177.       SUBROUTINE PGEX23
  178. C-----------------------------------------------------------------------
  179. C Demonstration program for the PGPLOT plotting package. 
  180. C-----------------------------------------------------------------------
  181.       INTEGER I
  182.       CHARACTER*80 SAMPLE(8)
  183.       DATA SAMPLE(1)
  184.      1 /'Normal:  \fnABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  185.       DATA SAMPLE(2)
  186.      1 /'Roman:  \frABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  187.       DATA SAMPLE(3)
  188.      1 /'Italic:  \fiABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  189.       DATA SAMPLE(4)
  190.      1 /'Script:  \fsABCDQ efgh 1234 \ga\gb\gg\gd \gL\gH\gD\gW'/
  191.       DATA SAMPLE(5)
  192.      1 /'\fif\fr(\fix\fr) = \fix\fr\u2\dcos(2\gp\fix\fr)e\u\fix\fr\u2'/
  193.       DATA SAMPLE(6)
  194.      1 /'\fiH\d0\u \fr= 75 \(2233) 25 km s\u-1\d Mpc\u-1\d'/
  195.       DATA SAMPLE(7)
  196.      1 /'\fsL/L\d\(2281)\u\fr = 5\.6 \x 10\u6\d (\gl1216\A)'/
  197.       DATA SAMPLE(8)
  198.      1 /'Markers: 3=\m3, 8=\m8, 12=\m12, 28=\m28.'/
  199. C
  200. C Call PGENV to initialize the viewport and window.
  201. C Call PGLAB to label the graph.
  202. C
  203.       CALL PGENV(0.,20.,8.,0.,0,-2)
  204.       CALL PGLAB(' ',' ','\fiPGPLOT \frFonts')
  205. C
  206. C Use PGTEXT to write the sample character strings.
  207. C
  208.       CALL PGSCH(1.6)
  209.       DO 10 I=1,8
  210.           CALL PGTEXT(0.0,FLOAT(I),SAMPLE(I))
  211.    10 CONTINUE
  212.       CALL PGSCH(1.0)
  213. C-----------------------------------------------------------------------
  214.       END
  215.  
  216.       SUBROUTINE PGEX24
  217. C-----------------------------------------------------------------------
  218. C Demonstration program for the PGPLOT plotting package. This example
  219. C illustrates the different line widths.
  220. C                              T. J. Pearson  1982 Dec 28
  221. C----------------------------------------------------------------------
  222.       INTEGER IW
  223.       REAL X(2), Y(2)
  224. C
  225. C Call PGENV to initialize the viewport and window.
  226. C
  227.       CALL PGBBUF
  228.       CALL PGENV(0.,15.,0.,15.,0,0)
  229. C
  230. C Call PGLAB to label the graph.
  231. C
  232.       CALL PGLAB('Line Width',' ','\fiPGPLOT \frLine Widths')
  233. C
  234. C Draw 14 oblique lines in different thicknesses.
  235. C
  236.       DO 10 IW=1,14
  237.           X(1) = IW
  238.           Y(1) = 0.0
  239.           X(2) = 0.0
  240.           Y(2) = IW
  241.           CALL PGSLW(IW)
  242.           CALL PGLINE(2,X,Y)
  243.    10 CONTINUE
  244. C
  245. C Draw another set of lines, dashed instead of solid.
  246. C
  247.       CALL PGSLS(2)
  248.       DO 20 IW=1,14
  249.           X(1) = IW
  250.           Y(1) = 15.0
  251.           X(2) = 15.0
  252.           Y(2) = IW
  253.           CALL PGSLW(IW)
  254.           CALL PGLINE(2,X,Y)
  255.    20 CONTINUE
  256. C
  257.       CALL PGSLS(1)
  258.       CALL PGSLW(1)
  259.       CALL PGEBUF
  260. C-----------------------------------------------------------------------
  261.       END
  262.  
  263.       SUBROUTINE PGEX25
  264. C-----------------------------------------------------------------------
  265. C Demonstration program for the PGPLOT plotting package. This program
  266. C tests polygon clipping on polygons and circles, and tests that
  267. C markers are clipped correctly. Note that markers exactly on the edge
  268. C of the window are supposed to be visible.
  269. C                              T. J. Pearson  1994 Nov 25
  270. C-----------------------------------------------------------------------
  271.       INTEGER I, J
  272.       REAL PX(43), PY(43), SX(5), SY(5), RX(3), RY(3)
  273.       DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3,
  274.      1          17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0,
  275.      2          28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1,
  276.      3          25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0,
  277.      4          10.0,  8.0,  6.1,  4.2,  3.0,  1.3 /
  278.       DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4,
  279.      1          9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9,
  280.      2          13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5,
  281.      3          9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7,
  282.      4          0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 /
  283.       DATA SX / 10.0, 10.0, 20.0, 30.0, 15.0 /
  284.       DATA SY /  0.0, -6.0, -6.0,  5.0, -3.5 /
  285.       DATA RX / 26.0, 27.0, 26.0 /
  286.       DATA RY / -4.0, -3.0, -3.0 /
  287. C
  288.       CALL PGPAGE
  289.       CALL PGVSTD
  290.       CALL PGBBUF
  291.       CALL PGSAVE
  292. C
  293. C Set window.
  294. C
  295.       CALL PGWNAD(5.0, 25.0, -5.0, 15.0)
  296.       CALL PGSCI(1)
  297.       CALL PGSLW(1)
  298.       CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0)
  299. C
  300. C Test clipping of polygons and circles
  301. C
  302.       CALL PGSFS(1)
  303.       CALL PGSCI(2)
  304.       CALL PGPOLY(43, PX, PY)
  305.       CALL PGSCI(0)
  306.       CALL PGSFS(3)
  307.       CALL PGSHS(30.0, 2.0, 0.0)
  308.       CALL PGPOLY(43, PX, PY)
  309.       CALL PGSCI(1)
  310.       CALL PGSHS(30.0, 4.0, 0.25)
  311.       CALL PGPOLY(43, PX, PY)
  312.       CALL PGSCI(1)
  313.       CALL PGSFS(2)
  314.       CALL PGPOLY(43, PX, PY)
  315. C
  316.       CALL PGSFS(1)
  317.       CALL PGSCI(4)
  318.       CALL PGPOLY(5, SX, SY)
  319.       CALL PGSCI(0)
  320.       CALL PGSFS(4)
  321.       CALL PGSHS(0.0, 1.6, 0.0)
  322.       CALL PGPOLY(5, SX, SY)
  323.       CALL PGSCI(1)
  324.       CALL PGSFS(2)
  325.       CALL PGPOLY(5, SX, SY)
  326. C     
  327. C       The next polygon should be invisible.
  328.       CALL PGSFS(1)
  329.       CALL PGSCI(4)
  330.       CALL PGPOLY(3, RX, RY)
  331.       CALL PGSCI(1)
  332.       CALL PGSFS(2)
  333.       CALL PGPOLY(3, RX, RY)
  334. C
  335.       CALL PGSFS(1)
  336.       CALL PGSCI(3)
  337.       CALL PGCIRC(8.0, 12.0, 3.5)
  338.       CALL PGSFS(2)
  339.       CALL PGSCI(1)
  340.       CALL PGCIRC(8.0, 12.0, 3.5)
  341. C
  342. C Test clipping of markers: all should be visible.
  343. C
  344.       CALL PGSCI(1)
  345.       CALL PGSLW(1)
  346.       DO 20 I=0,30,5
  347.          DO 10 J=-5,25,5
  348.             CALL PGPT(1,REAL(I),REAL(J),9)
  349.  10      CONTINUE
  350.  20   CONTINUE
  351. C
  352. C Draw box.
  353. C
  354.       CALL PGBOX('BCNST', 0.0, 0, 'BCNST', 0.0, 0)
  355.       CALL PGLAB(' ', ' ', 'PGPLOT: clipping polygons and markers')
  356. C
  357.       CALL PGUNSA
  358.       CALL PGEBUF
  359. C-----------------------------------------------------------------------
  360.       END
  361.  
  362.       SUBROUTINE PGEX26
  363. C-----------------------------------------------------------------------
  364.       CHARACTER*128 DEVICE
  365.       CHARACTER*80 GTYPE, GVER
  366.       INTEGER I, J, L, L1, L2
  367.       REAL X, X1, X2, Y, Y1, Y2, R, XI, XP, YP
  368.       REAL PX(43), PY(43)
  369.       DATA PX / 0.0,2.0,4.0,6.0,8.0,10.0,12.0,14.0,16.4,17.0,17.3,
  370.      1          17.8, 18.5, 20.0, 22.0, 24.0, 26.0, 28.0, 29.0,
  371.      2          28.8,27.2,25.0,23.0,21.5,21.1,21.5,22.8, 24.1, 25.1,
  372.      3          25.2, 24.2, 22.1, 20.0, 18.0, 16.0, 14.0, 12.0,
  373.      4          10.0,  8.0,  6.1,  4.2,  3.0,  1.3 /
  374.       DATA PY / 8.8, 7.6, 7.1, 7.4, 8.0, 8.9, 9.6, 9.9, 9.4,
  375.      1          9.7, 12.0, 14.0, 16.1, 17.0, 17.0, 16.0, 13.9,
  376.      2          13.1, 13.2, 12.3, 11.5, 11.5, 11.5, 11.2, 10.5,
  377.      3          9.0, 8.0, 7.0, 5.1, 3.6, 1.9, 1.1, 0.9, 0.7,
  378.      4          0.8, 1.0, 1.0, 1.2, 1.8, 2.1, 2.9, 4.1, 6.0 /
  379. C
  380.       CALL PGQINF('DEV/TYPE', DEVICE, L)
  381.       CALL PGQINF('VERSION', GVER, L1)
  382.       CALL PGQINF('TYPE', GTYPE, L2)
  383.       CALL PGBBUF
  384. C
  385. C Clear the screen; set background and foreground colors.
  386. C
  387.       CALL PGPAGE
  388.       CALL PGSCR(0,0.0,0.0,0.35)
  389.       CALL PGSCR(1,1.0,1.0,1.0)
  390.       CALL PGERAS
  391. C
  392. C Draw a frame at the physical extremities of the plot.
  393. C Dimensions are X by Y (inches).
  394. C
  395.       CALL PGSVP(0.0, 1.0, 0.0, 1.0)
  396.       CALL PGQVP(1, X1, X2, Y1, Y2)
  397.       X = X2-X1
  398.       Y = Y2-Y1
  399.       CALL PGSWIN(0.0, X, 0.0, Y)
  400.       CALL PGSFS(2)
  401.       CALL PGRECT(0.0, X, 0.0, Y)
  402.       CALL PGMOVE(0.5*X, 0.0)
  403.       CALL PGDRAW(0.5*X, Y)
  404.       CALL PGMOVE(0.0, 0.5*Y)
  405.       CALL PGDRAW(X, 0.5*Y)
  406. C
  407. C Draw a circle of diameter 0.5 x min(x,y)
  408. C
  409.       R = 0.25*MIN(X,Y)
  410.       CALL PGCIRC(X*0.5, Y*0.5, R)
  411. C
  412. C Draw some more circles with different line-styles; this tests
  413. C the dashing algorithm on curved lines.
  414. C
  415.       CALL PGSLS(2)
  416.       CALL PGCIRC(X*0.5, Y*0.5, R*1.1)
  417.       CALL PGSLS(3)
  418.       CALL PGCIRC(X*0.5, Y*0.5, R*1.2)
  419.       CALL PGSLS(2)
  420.       CALL PGSLW(3)
  421.       CALL PGCIRC(X*0.5, Y*0.5, R*1.3)
  422.       CALL PGSLS(1)
  423.       CALL PGSLW(1)      
  424. C
  425. C Demonstrate different line-styles
  426. C
  427.       DO 10 I=1,5
  428.           CALL PGSLS(I)
  429.           CALL PGMOVE(I*(X/20.0),0.0)
  430.           CALL PGDRAW(I*(X/20.0),Y)
  431.    10 CONTINUE
  432.       CALL PGSLS(1)
  433. C
  434. C Demonstrate different line-widths
  435. C
  436.       DO 20 I=1,5
  437.           CALL PGSLW(I)
  438.           CALL PGMOVE(0.0, I*(Y/20.0))
  439.           CALL PGDRAW(X, I*(Y/20.0))
  440.    20 CONTINUE
  441.       CALL PGSLW(1)
  442. C
  443. C Demonstrate different line-colors
  444. C
  445.       CALL PGSLW(4)
  446.       DO 40 I=0,15
  447.           CALL PGSCI(I)
  448.           XI = (I+20)*(X/40.0)
  449.           CALL PGMOVE(XI,0.0)
  450.           CALL PGDRAW(XI,Y)
  451.    40 CONTINUE
  452.       CALL PGSCI(1)
  453.       CALL PGSLW(1)
  454. C
  455. C Draw dots in different thicknesses.
  456. C
  457.       XP = (14+20)*(X/40.0)
  458.       DO 30 I=1,21
  459.           YP = I*Y/22.0
  460.           CALL PGSLW(I)
  461.           CALL PGPT(1,XP,YP,-1)
  462.    30 CONTINUE
  463.       CALL PGSLW(1)
  464. C
  465. C Demonstrate fill area
  466. C
  467.       DO 50 J=1,43
  468.          PX(J) = (PX(J)+50.0)/100.0*X
  469.          PY(J) = (PY(J)+75.0)/100.0*Y
  470.    50 CONTINUE
  471.       DO 70 I=0,3
  472.           CALL PGSCI(I)
  473.           CALL PGSFS(1)
  474.           CALL PGPOLY(43,PX,PY)
  475.           CALL PGSCI(1)
  476.           CALL PGSFS(2)
  477.           CALL PGPOLY(43,PX,PY)
  478.           DO 60 J=1,43
  479.              PY(J) = PY(J)-0.25*Y
  480.    60     CONTINUE
  481.    70 CONTINUE
  482. C
  483. C Write the device type on the plot.
  484. C
  485.       CALL PGSWIN(0.0, 1.0, 0.0, 1.0)
  486.       CALL PGSFS(1)
  487.       CALL PGSCI(0)
  488.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  489.       CALL PGSCI(1)
  490.       CALL PGSFS(2)
  491.       CALL PGRECT(0.31, 1.0-0.31, 0.85, 0.97)
  492.       CALL PGPTXT(0.5, 0.91, 0.0, 0.5, 'PGPLOT '//GVER(1:L1))
  493.       CALL PGPTXT(0.5, 0.87, 0.0, 0.5, 'Device '//GTYPE(1:L2))
  494. C
  495.       CALL PGEBUF
  496. C-----------------------------------------------------------------------
  497.       END
  498.